&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*------------------------------------------------------------------------

  File: 

  Description: 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

  Created: 

------------------------------------------------------------------------*/
/*           This .W file was created with the Progress AppBuilder.     */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */


DEF VAR buf-nocli       AS INTEGER                   NO-UNDO.
DEF VAR buf-csmt        AS INTEGER                   NO-UNDO.
DEF VAR buf-adresse     AS CHARACTER                 NO-UNDO.
DEF VAR flag-ok         AS LOGICAL                   NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 14.17
         WIDTH              = 60.63.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure 
/* ************************* Included-Libraries *********************** */

{src/web2/wrap-cgi.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ************************  Main Code Block  *********************** */

/* Process the latest Web event. */
RUN process-web-request.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&IF DEFINED(EXCLUDE-lecture_adresse) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE lecture_adresse Procedure 
PROCEDURE lecture_adresse :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF OUTPUT PARAMETER p-adresse   AS    CHARACTER              NO-UNDO.
DEF OUTPUT PARAMETER p-ok        AS    LOGICAL INIT TRUE      NO-UNDO.

DEF VAR vcWebResp    AS CHARACTER        NO-UNDO.
DEF VAR lSucess      AS LOGICAL          NO-UNDO.
DEF VAR mResponse    AS MEMPTR           NO-UNDO.
DEF VAR mRequest       AS MEMPTR.
DEF VAR postUrl AS CHAR.
DEF VAR vcRequest as char format "x(100)" no-undo.
DEF VAR postData  as char format "x(100)" no-undo.
DEF VAR vhSocket   AS HANDLE                                NO-UNDO.
DEF VAR i AS INTEGER NO-UNDO.


CREATE SOCKET vhSocket.

vhSocket:CONNECT("-H www.saferpay.com -S 443 -ssl -nohostverify") NO-ERROR.
IF vhSocket:CONNECTED() = FALSE THEN DO:
   p-ok = FALSE.
   p-adresse = ERROR-STATUS:GET-MESSAGE(1).
   RETURN.
END.

postUrl = "/hosting/CreatePayInit.asp".
postData = "?spPassword=JFrY6io@qi"
          + "&ACCOUNTID=99867-94913159"
          + "&ORDERID=WEB-12345"
          + "&AMOUNT=5000"
          + "&CURRENCY=CHF"
          + "&LANGID=fr"
          + "&DESCRIPTION=Test"
          + "&SUCCESSLINK=http://www.parvis.ch/cgi-bin/cgiip.exe/WService=wsbroker1/pmt_ok.htm?xxx="
          + "&FAILLINK=http://www.parvis.ch/cgi-bin/cgiip.exe/WService=wsbroker1/pmt_nok.htm?xxx=".

vcRequest = 'GET ' +
            postUrl +
            postData +
            " HTTP/1.0 ~r~n" +
            "Host: secure2.nmi.com" +
            "~r~nUser-Agent: " +
            "~r~nConnection: close~r~n~r~n"
            .

SET-SIZE(mRequest)            = 0.
SET-SIZE(mRequest)            = LENGTH(vcRequest) + 1.
SET-BYTE-ORDER(mRequest)      = BIG-ENDIAN.
PUT-STRING(mRequest,1)        = vcRequest .

vhSocket:WRITE(mRequest, 1, LENGTH(vcRequest)).

PAUSE 3 NO-MESSAGE.

DO WHILE vhSocket:GET-BYTES-AVAILABLE() > 0:
          
        SET-SIZE(mResponse) = vhSocket:GET-BYTES-AVAILABLE() + 1.
        SET-BYTE-ORDER(mResponse) = BIG-ENDIAN.
        vhSocket:READ(mResponse,1,1,vhSocket:GET-BYTES-AVAILABLE()).
        vcWebResp = vcWebResp + GET-STRING(mResponse,1).
END.

i = INDEX(vcWebResp,"https://www.saferpay.com").
p-adresse = SUBSTRING(vcWebResp,i).

vhSocket:DISCONNECT().
DELETE OBJECT vhSocket.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-outputHeader) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE outputHeader Procedure 
PROCEDURE outputHeader :
/*------------------------------------------------------------------------------
  Purpose:     Output the MIME header, and any "cookie" information needed 
               by this procedure.  
  Parameters:  <none>
  Notes:       In the event that this Web object is state-aware, this is
               a good place to set the webState and webTimeout attributes.
------------------------------------------------------------------------------*/

  /* To make this a state-aware Web object, pass in the timeout period 
   * (in minutes) before running outputContentType.  If you supply a timeout 
   * period greater than 0, the Web object becomes state-aware and the 
   * following happens:
   *
   *   - 4GL variables webState and webTimeout are set
   *   - a cookie is created for the broker to id the client on the return trip
   *   - a cookie is created to id the correct procedure on the return trip
   *
   * If you supply a timeout period less than 1, the following happens:
   *
   *   - 4GL variables webState and webTimeout are set to an empty string
   *   - a cookie is killed for the broker to id the client on the return trip
   *   - a cookie is killed to id the correct procedure on the return trip
   *
   * Example: Timeout period of 5 minutes for this Web object.
   *
   *   setWebState (5.0).
   */
    
  /* 
   * Output additional cookie information here before running outputContentType.
   *      For more information about the Netscape Cookie Specification, see
   *      http://home.netscape.com/newsref/std/cookie_spec.html  
   *   
   *      Name         - name of the cookie
   *      Value        - value of the cookie
   *      Expires date - Date to expire (optional). See TODAY function.
   *      Expires time - Time to expire (optional). See TIME function.
   *      Path         - Override default URL path (optional)
   *      Domain       - Override default domain (optional)
   *      Secure       - "secure" or unknown (optional)
   * 
   *      The following example sets cust-num=23 and expires tomorrow at (about) the 
   *      same time but only for secure (https) connections.
   *      
   *      RUN SetCookie IN web-utilities-hdl 
   *        ("custNum":U, "23":U, TODAY + 1, TIME, ?, ?, "secure":U).
   */ 
  output-content-type ("text/html":U).
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-process-web-request) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-web-request Procedure 
PROCEDURE process-web-request :
/*------------------------------------------------------------------------------
  Purpose:     Process the web request.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  
  /* 
   * Output the MIME header and set up the object as state-less or state-aware. 
   * This is required if any HTML is to be returned to the browser.
   */
   
  RUN outputHeader.
  
  {&OUT}
    "<HTML>":U SKIP
    "<HEAD>":U SKIP
    "<TITLE> {&FILE-NAME} </TITLE>":U SKIP
    "</HEAD>":U SKIP
    "<BODY>":U SKIP.
  
  RUN lecture_adresse(OUTPUT buf-adresse,OUTPUT flag-ok).

  IF NOT flag-ok THEN {&out} buf-adresse.
  ELSE {&out} "<script language=~"javascript~">" SKIP
              "document.location  = ~"" buf-adresse
              "~";" SKIP "</script>" SKIP.
  
  {&OUT}
    "</BODY>":U SKIP
    "</HTML>":U SKIP
    .
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

